SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00038 BITWISE TRANSLATIONS ROUTINES 1 05-28-9313:53ALL SWAG SUPPORT TEAM BITS1.PAS IMPORT 14 ₧8┴ {π Sean Palmerππ> What if I want to just access a bit? Say I have a Byte, to storeπ> Various access levels (if it does/doesn't have this, that, or theπ> other). How can Iππ> 1) Access, say, bit 4?π> 2) Give, say, bit 4, a value of 1?ππ> I have a simple routine that does "GetBit:= Value SHR 1;" to returnπ> a value, but how can I *SET* a value? And is the above a goodπ> method? I only have TP5.5, so I can't do the Asm keyWord (yet..).ππYou COULD use TP sets to do it...π}ππTypeπ tByte = set of 0..7;πVarπ b : Byte;ππ{to get:π Write('Bit 0 is ',Boolean(0 in tByte(b)));ππto set:π tByte(b):=tByte(b)+[1,3,4]-[0,2];π}ππTypeπ bitNum = 0..7;π bit = 0..1;ππFunction getBit(b : Byte; n : bitNum) : bit;πbeginπ getBit := bit(odd(b shr n));πend;ππFunction setBit( b : Byte; n : bitNum) : Byte;πbeginπ setBit := b or (1 shl n);πend;ππFunction clrBit(b : Byte; n : bitNum) : Byte;πbeginπ clrBit := b and hi($FEFF shl n);πend;ππ{π OR.....using Inline() code (the fastest)π These are untested but I'm getting fairly good at assembling by hand...8)π}ππFunction getBit(b : Byte; n : bitNum) : bit;πInline(π $59/ {pop cx}π $58/ {pop ax}π $D2/$E8/ {shr al,cl}π $24/$01); {and al,1}ππFunction setBit(b : Byte; n : bitNum) : Byte;πInline(π $59/ {pop cx}π $58/ {pop ax}π $B3/$01/ {mov bl,1}π $D2/$E3/ {shl bl,cl}π $0A/$C3); {or al,bl}ππFunction clrBit(b : Byte; n : bitNum) : Byte;πInline(π $59/ {pop cx}π $58/ {pop ax}π $B3/$FE/ {mov bl,$FE}π $D2/$C3/ {rol bl,cl}π $22/$C3); {or al,bl}π 2 05-28-9313:53ALL SWAG SUPPORT TEAM BITS2.PAS IMPORT 25 ₧8!5 {πROB GREENππ> What if I want to just access a bit? Say I have a Byte, to storeπ> Various access levels (if it does/doesn't have this, that, or theπ> other). How can Iπ> 1) Access, say, bit 4?π> 2) Give, say, bit 4, a value of 1?ππHeres a Procedure i wrote to handle all that. if you need speed, thenπi suggest to manually check each bit, rather than use the Procedures.ππ(these Procedures are based on 1, not 0. thus each Byte is like so:π87654321 instead of 76543210. to change to 0 base, change the Array toπ[0..31] instead of [1..32].)ππto set a bit: (b is an Integer Type, BIT is which bit to setπ b:=b or BIT; ex: b:=b or 128 (set bit 8)ππto clear a bit:π b:=b and not BIT; ex:b:=b and not 8; (clears bit 4)ππto check a bit:π if b and BIT<>0 then.. ex:if b and 64 then.. (check bit 7)π}ππConstπ{ Used to convert the Bit value to the actual corresponding number }π bit : Array[1..32] of LongInt =π (1, 2, 4, 8, $10, $20, $40, $80, $100, $200, $400, $800, $1000, $2000,π $4000, $8000, $10000, $20000, $40000, $80000, $100000, $200000,π $400000, $800000, $1000000, $2000000, $4000000, $8000000, $10000000,π $20000000, $40000000, $80000000);ππ{b is which bit to set(1-32), size is the size of temp.πUse SIZEOF(TEMP) to get the value, and temp is the actuall Integer basedπnumberπreturns True if bit set, False if not}ππFunction checkbit(b : Byte; size : Byte; Var temp) : Boolean; {1-32}πVarπ c : Boolean;πbeginπ c:=False;π Case size ofπ 1 : c := Byte(temp) and bit[b] <> 0; {Byte,shortint}π 2 : c := Word(temp) and bit[b] <> 0; {Word,Integer}π 4 : c := LongInt(temp) and bit[b] <> 0; {LongInt}π elseπ Writeln('Invalid size');π end;π checkbit := c;πend;ππ{b,size,and temp same as above. if onoff =True the bit will be set,πelse the bit will be cleared}ππProcedure setbit(b : Byte; onoff : Boolean; size : Byte; Var temp); {1-32}πbeginπ if onoff thenπ Case size ofπ 1 : Byte(temp) := Byte(temp) or bit[b]; {Byte}π 2 : Word(temp) := Word(temp) or bit[b]; {Word}π 4 : LongInt(temp) := LongInt(Temp) or bit[b]; {LongInt}π elseπ Writeln('Invalid size');π endπ elseπ Case size ofπ 1 : Byte(temp) := Byte(temp) and not bit[b]; {Byte}π 2 : Word(temp) := Word(temp) and not bit[b]; {Word}π 4 : LongInt(temp) := LongInt(Temp) and not bit[b];{LongInt}π elseπ Writeln('Invalid size');π end;πend;ππ{this is a sample test Program i wrote For you to see how to use theπstuff above}ππVarπ i : LongInt;π j : Byte;πbeginπ i := 0;π setbit(4,True,sizeof(i),i); {8}π Writeln(i);π setbit(9,True,sizeof(i),i); {256+8 = 264}π Writeln(i);π setbit(9,False,sizeof(i),i); {8}π Writeln(i);π setbit(20,True,sizeof(i),i); { $80000+8 = $80008}π Writeln(i);π For i := 65550 to 65575 doπ beginπ Write(i : 8, ' = ');π For j := 32 downto 1 do {to print right}π if checkbit(j, sizeof(i), i) thenπ Write('1')π elseπ Write('0');π Writeln;π end;πend.π 3 05-28-9313:53ALL SWAG SUPPORT TEAM BIT_GET.PAS IMPORT 3 ₧8Ñ' { You can use multiplies of 2 like: }ππFunction Find_Bit(B, c : Byte) : Byte;π{c is the position c=0 far right c=7 far leftπreturns 0 or 1}πbeginπ if b MOD (b shl c) = 0 then Find_Bit := 0π else Find_Bit := 1πend;ππ 4 05-28-9313:53ALL SWAG SUPPORT TEAM BIT_ROT1.PAS IMPORT 8 ₧8à╨ The commands you need to rotate a Byte/Word are:ππROR, ROL, RCR, RCL.πROR ==> Rotates the bits the number of times specified, so that theπ rightmost bits are rotated into the leftmost bits. NO BITSπ ARE LOST. ROL is the same thing in the opposite direction.ππRCR ==> Practically the same as the ROR/ROL instruction, but it rotatesπ the bit into the carry, and the carry bit is rotated into theπ leftmost bit of the Byte/Word. {Rotate right through carry}π RCL is the same in the other direction.ππThe format For each of ROR,ROL,RCR,RCL,SHR,SHL isππ [Instruction] <Destination> <Shift Count>ππTo reWrite your original code:ππAsmπ Mov AL, ByteVarπ Ror AL, 1π Mov ByteVar, ALπendππThe above would rotate the bits in the Variable ByteVar by one to the right.π 5 05-28-9313:53ALL CHRIS PRIEDE Rotate Bits LEFT/RIGHT IMPORT 14 ₧8G > I made a Program in Turbo-Pascal that rotates the bits in one Byte so I canπ> encrypt/decrypt a File, however the routine is slow. I then made the sameπ> Program in turbo-C using _RotLeft and _RotRight, the speed of execution wasπ> Really faster than Turbo-Pascal. Does anybody know of a way to rotate theπ> bits of one Byte in turbo-Pascal and FAST !!!!πππ Since 80xxx CPUs have bit rotate instructions (ROL, ROR), it wouldπbe a shame to use some clumsy HLL Construct. BTW, I'm sure _RotLeft andπ_RotRight use rotate instructions too, possibly insert them Inline. Ifπyou are using TP 6.0+, try something like this:ππ{ to rotate left }πFunction RotLeft(B, Count: Byte): Byte; Assembler;πAsmπ mov al, Bπ mov cl, Countπ rol al, clπend;ππ{ to rotate right }πFunction RotRight(B, Count: Byte): Byte; Assembler;πAsmπ mov al, Bπ mov cl, Countπ ror al, clπend;πππ Of course, if you need to do this in only a few places it wouldπbe better not to define Functions, but insert Asm blocks in your codeπdirectly.ππ The fastest Pascal way to rotate Byte would be something likeπthis:ππFunction RotLeft(B, Count: Byte): Byte;πVarπ W : Word;π A : Array[0..1] of Byte Absolute W;πbeginπ A[0] := B;π A[1] := B;π W := W shl Count;π RotLeft := A[1];πend;ππ To rotate right With this method, you would shift right andπreturn A[0]. I would like to think this is as fast as it gets in TPπwithout assembly, but one can never be sure <g>. Anyway, I recommendπthe assembly solution over this one, it is faster and more elegant.π 6 05-28-9313:53ALL SWAG SUPPORT TEAM BIT_ROT3.PAS IMPORT 5 ₧8¬ {πSEAN PALMERπ}ππFunction rolW(b : Word; n : Byte) : Word; Assembler;πAsmπ mov ax, bπ mov cl, nπ rol ax, clπend;ππFunction rolB(b, n : Byte) : Byte; Assembler;πAsmπ mov al, bπ mov cl, nπ rol al, clπend;ππFunction rolW1(b : Word) : Word; Assembler;πAsmπ mov ax, bπ rol ax, 1πend;ππ{ These would be better off as Inline Functions, such as... }ππFunction IrolW1(b : Word) : Word;πInline(π $58/ {pop ax}π $D1/$C0); {rol ax,1}ππ{ because no Function call is generated. }ππ 7 05-28-9313:53ALL SWAG SUPPORT TEAM BYT2REAL.PAS IMPORT 5 ₧8Ç, Typeπ bsingle = Array [0..3] of Byte;ππ{ converts Microsoft 4 Bytes single to TP Real }ππFunction msb_to_Real (b : bsingle) : Real;πVarπ pReal : Real;π r : Array [0..5] of Byte Absolute pReal;πbeginπ r [0] := b [3];π r [1] := 0;π r [2] := 0;π move (b [0], r [3], 3);π msb_to_Real := pReal;πend; { Function msb_to_Real }ππ{πAnother Turbo Pascal routine to convert Microsoft single to TP LongIntππindex := ((mssingle and not $ff000000) or $00800000) shr (24 -π((mssingle shr 24) and $7f)) - 1;π}π 8 05-28-9313:53ALL SWAG SUPPORT TEAM BYTE2BIN.PAS IMPORT 7 ₧8"a {πByte to Binary...π}ππTypeπ String8 = String[8];πππFunction Byte2Bin(byTemp : Byte) : String8;πVarπ Count : Integer;πbeginπ Byte2Bin[0] := #8;π For Count := 0 to 7 doπ Byte2Bin[8 - Count] := Char(((byTemp shr Count) and 1) + ord('0'));πend;ππFunction Byte2BinAsm(byTemp : Byte) : String8; Assembler;πAsmπ push dsπ les di,@resultπ mov ah,byTempπ mov cl,8π mov al,clπ stosbπ@loop:π mov al,24π add ah,ahπ adc al,alπ stosbπ loop @loopπ pop dsπend;ππbeginπ Writeln;π Writeln('10 in Binary = ',Byte2Bin(10));π Writeln;π Writeln('The same thing With assembly code: ',Byte2BinAsm(10));π Writeln;π Readln;πend. 9 05-28-9313:53ALL SWAG SUPPORT TEAM BYTEINFO.PAS IMPORT 57 ₧8⌐└ {π>Also, how would I simply read each bit?π}π{ Test if a bit is set. }πFunction IsBitSet(Var INByte : Byte; Bit2Test : Byte) : Boolean;πbeginπ if (Bit2Test in [0..7]) thenπ IsBitSet := ((INByte and (1 shl Bit2Test)) <> 0)π elseπ Writeln('ERROR! Bit to check is out of range!');πend; { IsBitSet. }ππ{π>How on earth can I manipulate an individual bit?ππ...One method is to use the bit-operators: AND, OR, XOR, NOTπ}ππ{ Manipulate an individual BIT within a single Byte. }πProcedure SetBit(Bit2Change : Byte; TurnOn : Boolean; Var INByte : Byte);πbeginπ if Bit2Change in [0..7] thenπ beginπ if TurnOn thenπ INByte := INByte or (1 shl Bit2Change)π elseπ INByte := INByte and NOT(1 shl Bit2Change);π end;πend; { SetBit. }ππ{π>...but I'm not sure exactly what the shifting is doing.π}ππ { Check if the bit is to be turned on or off. }π If TurnOn thenππ {π SHL 1 (which has a bit map of 0000 0001) to the bitπ position we want to turn-on.ππ ie: 1 SHL 4 = bit-map of 0001 0000ππ ...Then use a "logical OR" to set this bit.ππ ie: Decimal: 2 or 16 = 18π Binary : 0000 0010 or 0001 0000 = 0001 0010π }ππ INByte := INByte or (1 shl Bit2Change)π elseππ {π Else turn-off bit.ππ SHL 1 (which has a bit map of 0000 0001) to the bitπ position we want to turn-off.ππ ie: 1 SHL 4 = bit-map of 0001 0000ππ ...Then use a "logical NOT" to flip all the bits.ππ ie: Decimal: not ( 16 ) = 239π Binary : not (0001 0000) = (1110 1111)ππ ...Than use a "logical AND" to turn-off the bit.ππ ie: Decimal: 255 and 239 = 239π Binary : 1111 1111 and 1110 1111 = 1110 1111π }ππ INByte := INByte and NOT(1 shl Bit2Change);ππ{π>Also, how can you assign a Byte (InByte) a Boolean value (OR/AND/NOT)ππ or / xor / and / not are "logical" bit operators, that can be use onπ "scalar" Types. (They also Function in the same manner For "Boolean"π logic.)ππ>If I have, say 16 bits in one Byte, the interrupt list says that forπ>instance the BIOS calls (INT 11), AX is returned With the values. Itπ>says that the bits from 9-11 tell how many serial portss there are.π>How do I read 3 bits?ππ To modify the two routines I posted wo work With 16 bit Variables,π you'll need to change:ππ INByte : Byte; ---> INWord : Word;ππ ...Also:ππ in [0..7] ---> in [0..15]ππ ...If you don't want to use the IsBitSet Function listed aboveπ (modified to accept 16-bit Word values) you could do the followingπ to check if bits 9, 10, 11 are set in a 16-bit value:ππ The following is the correct code For reading bits 9, 10, 11π of the 16-bit Variable "AX_Value" :ππ Port_Count := ((AX_Value and $E00) SHR 9);ππ NOTE: Bit-map For $E00 = 0000 1110 0000 0000ππ ...If you've got a copy of Tom Swan's "Mastering Turbo Pascal",π check the section on "logical operators".πππ{π>Var Regs : Registers;π>beginπ> Intr($11,Regs);π> Writeln(Regs.AX);π>end.ππ>How do I manipulate that to read each bit (or multiple bits likeπ>the number of serial ports installed (bits 9-11) ?π}ππUsesπ Dos;ππVarπ Port_Count : Byte;π Regs : Registers;ππbeginπ Intr($11, Regs);π Port_Count := ((Regs.AX and $E00) SHR 9);π Writeln('Number of serial-ports = ', Port_Count)πend.π{πNOTE: The hex value of $E00 is equivalent to a 16-bit value withπ only bits 9, 10, 11 set to a binary 1. The SHR 9 shifts theπ top Byte of the 16-bit value, to the lower Byte position.π}π{π>Is $E00 the same as $0E00 (ie, can you just omit leading zeros)?ππYeah, it's up to you if you want to use the leading zeros or not.ππThe SHR 9 comes in because once the value has been "AND'd" withπ$E00, the 3 bits (9, 10, 11) must be placed at bit positions:π0, 1, 2 ...to correctly read their value.ππFor example, say bits 9 and 11 were set, but not bit 10. If weπ"AND" this With $E00, the result is $A00.ππ1011 1010 0111 1110 and 0000 1110 0000 0000 = 0000 1010 0000 0000π ^ ^π(bits 9,11 are set) and ( $E00 ) = $A00π...Taking the result of $A00, and shifting it right 9 bit positionsππ $A00 SHR 9 = 5ππ 0000 1010 0000 0000 SHR 9 = 0000 0000 0000 0101ππ...Which evalutates to 5. (ie: 5 serial ports)π}ππππππππππ{πGet Equipment Bit-Mapπ---------------------ππ AH ALπ 76543210 76543210πAX = ppxgrrrx ffvvmmciππ...π...πrrr = # of RS232 ports installedπ...π...ππ (* reports the number of RS232 ports installed *)πFunction NumRS232 : Byte;πVar Regs : Registers; (* Uses Dos *)πbeginπ Intr($11,Regs);π NumRS232 := (AH and $0E) shr 1;πend;πππ...When you call Int $11, it will return the number of RS232 ports installedπin bits 1-3 in register AH.ππFor example if AH = 01001110 , you can mask out the bits you *don't* wantπby using AND, like this:ππ 01001110 <--- AHπ and 00001110 <---- mask $0Eπ ──────────────π 00001110 <---- after maskingπππThen shift the bits to the right With SHR,ππ 00001110 <---- after maskingπ SHR 1 <---- shift-right one bit positionπ ─────────────π 00000111 <---- result you wantπ}ππ{π-> How do I know to use $4 For the third bit? Suppose I want to readπ-> the fifth bit. Do I simply use b := b or $6?ππ Binary is a number system just like decimal. Let me explain.πFirst, consider the number "123" in decimal. What this means,πliterally, isππ1*(10^2) + 2*(10^1) + 3*(10^0), which is 100 + 20 + 3.ππ Binary works just the same, however instead of a 10, a 2 is used asπthe base. So the number "1011" meansππ1*(2^3) + 0*(2^2) + 1*(2^1) + 1*(2^0), or 8+0+2+1, or 11.ππ This should make it clear why if you wish to set the nth bit toπTrue, you simply use a number equal to 2^(n-1). (The -1 is thereπbecause you probably count from 1, whereas the powers of two, as you mayπnote, start at 0.)ππ-> b or (1 SHL 2) Would mean that b := 1 (True) if b is already equal toπ-> one (1) and/OR the bit two (2) to the left is one (1) ???ππ Aha. You are not familiar With bitwise or operations. When oneπattempts to or two non-Boolean values (Integers), instead of doing aπlogical or as you are familiar with, each individual BIT is or'd. I.E.πimagine a Variables A and B had the following values:ππa := 1100 (binary);πb := 1010 (binary);ππthen, a or b would be equal to 1110 (binary); Notice that each bit of aπhas been or'd With the corresponding bit of b? The same goes For and.πHere's an example.ππa := 1100 (binary);πb := 1010 (binary);ππa and b would be equal to 1000;ππI hope this clears up the confusion. And just to be sure, I'm going toπbriefly show a SHL and SHR operation to make sure you know. Considerπthe numberππa := 10100 (binary);ππThis being the number, A SHL 2 would be equal to 1010000 (binary) --πnotice that it has been "shifted to the left" by 2 bits.ππA SHR 1 would be 1010 (binary), which is a shifted to the right by 2πbits.π}ππ 10 05-28-9313:53ALL SWAG SUPPORT TEAM DEC2BIN1.PAS IMPORT 6 ₧8Q▓ {π> I need to transfer decimal into binary using TURBO PASCAL.π> One way to do this is to use the basic algorithm, dividingπ> by 2 over and over again. if the remainder is zero theπ> bit is a 0, else the bit is a 1.π>π> However, I was wondering if there is another way to convertπ> from decimal to binary using PASCAL. Any ideas?ππAs an 8-bit (ie. upto 255) example...π}ππ Function dec2bin(b:Byte) : String;π Var bin : String[8];π i,a : Byte;π beginπ a:=2;π For i:=8 downto 1 doπ beginπ if (b and a)=a then bin[i]:='1'π else bin[i]:='0';π a:=a*2;π end;π dec2bin:=bin;π end;ππ 11 05-28-9313:53ALL SWAG SUPPORT TEAM DEC2BIN2.PAS IMPORT 7 ₧8₧è { True so here is another version of the process that returns a String : }ππProgram Dec2BinRec;ππTypeπ Str32 = String[32];ππFunction Dec2BinStr(aNumber : LongInt) : Str32;ππ Function Bit(aBit : Byte) : Char;π (* return either Char '0' or Char '1' *)π beginπ if aBit = 0 thenπ Bit := '0'π elseπ Bit := '1'π end;ππbeginπ If aNumber = 0 Thenπ Dec2BinStr := '' (* done With recursion ?*)π else (* convert high bits + last bit *)π Dec2BinStr := Dec2BinStr(ANumber Div 2) + Bit(aNumber Mod 2);πend;ππVarπ L : LongInt;πbeginπ Repeatπ Readln (L);π If L <> 0 thenπ Writeln(Dec2BinStr(L));π Until (L = 0)πend.π 12 05-28-9313:53ALL SWAG SUPPORT TEAM HEX2BIN1.PAS IMPORT 22 ₧8/ Function Hex2Bin (B : Byte) : String;ππVarπ Temp : String [8];π Pos, Mask : Byte;ππbeginπ Temp := '00000000';π Pos := 8;π Mask := 1;π While (Pos > 0) Doπ beginπ if (B and Mask)π thenπ Temp [Pos] := '1';π Dec (Pos);π Mask := 2 * Mask;π end;π Hex2Bin := Temp;πend;ππππππππFunction Hex2Bin( HexByte:Byte ):String; External; {$L HEX2Bin.OBJ}πVar i : Integer;πbeginπ For i := $00 to $0F do WriteLn( Hex2Bin(i) );πend.π(*********************************************************************)ππ The Assembly source ...ππ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;πcode segment Byte 'CODE' ; HEX2Bin.Asmπ assume cs:codeπ; Function Hex2Bin( HexByte :Byte ) :String;πString equ dWord ptr [bp+6]πHexByte equ [bp+4]π public Hex2BinπHex2Bin proc Near ; link into main TP Programπ push bp ; preserveπ mov bp,sp ; stack frameπ les di, String ; result String Pointerπ cld ; Forward scanπ mov cx,8 ; 8 bits in a Byteπ mov al,cl ; to setπ stosb ; binary String lengthπ mov ah, HexByte ; get the hex Byteπ h2b: xor al,al ; cheap zeroπ rol ax,1 ; high bit to low bitπ or al,'0' ; make it asciiπ stosb ; put it in Stringπ loop h2b ; get all 8 bitsπ pop bp ; restoreπ ret 2 ; purge stack & returnπHex2Bin endpπcode endsπ endπ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;ππ Here's the assembled OBJ File ...ππ Put all of this remaining message in a Text File named HEX2Bin.SCR,π then Type "DEBUG < HEX2Bin.SCR" (no quotes) to create HEX2Bin.ARC;π then extract HEX2Bin.OBJ using PKUNPAK or PAK ...π ---------------------------- DEBUG script ----------------------------π N HEX2Bin.ARCπ E 0100 1A 02 48 45 58 32 42 49 4E 2E 4F 42 4A 00 5E 65 00 00 00 4A 19π E 0115 13 22 60 F2 65 00 00 00 80 0D 00 0B 68 65 78 32 62 69 6E 2E 41π E 012A 53 4D A9 96 07 00 00 04 43 4F 44 45 44 98 07 00 20 1D 00 02 02π E 013F 01 1F 90 0E 00 00 01 07 48 45 58 32 42 49 4E 00 00 00 6A 88 04π E 0154 00 00 A2 01 D1 A0 21 00 01 00 00 55 8B EC C4 7E 06 FC B9 08 00π E 0169 8A C1 AA 8A 66 04 32 C0 D1 C0 0C 30 AA E2 F7 5D C2 02 00 21 8Aπ E 017E 02 00 00 74 1A 00π Rcxπ 0084π Wπ Qπ ----------------------------------------------------------gbug-1.0b--π 13 05-28-9313:53ALL SWAG SUPPORT TEAM HEXCONV.PAS IMPORT 7 ₧8x╟ Varπ n : Word;π long : LongInt;ππFunction Byte2Hex(numb : Byte): String; { Converts Byte to hex String }π Constπ HexChars : Array[0..15] of Char = '0123456789ABCDEF';π beginπ Byte2Hex[0] := #2;π Byte2Hex[1] := HexChars[numb shr 4];π Byte2Hex[2] := HexChars[numb and 15];π end; { Byte2Hex }ππFunction Numb2Hex(numb: Word): String; { Converts Word to hex String.}π beginπ Numb2Hex := Byte2Hex(hi(numb))+Byte2Hex(lo(numb));π end; { Numb2Hex }ππFunction Long2Hex(L: LongInt): String; { Converts LongInt to hex String }π beginπ Long2Hex := Numb2Hex(L shr 16) + Numb2Hex(L);π end; { Long2Hex }πππbeginπ long := 65536;π n := 256;π Writeln(Long2Hex(long));π Writeln(Numb2Hex(n));πend.π 14 05-28-9313:53ALL SWAG SUPPORT TEAM HEXINFO.PAS IMPORT 13 ₧8Φó > I am learning Pascal and don't understand something. How does theπ> following Function make a Word into Hex:ππ It's Really doing two things, it's converting a binary valueπ into ascii, and from decimal to hex. Let's start With theπ calling or main part of the Program. You're taking a 2 Byteπ Word and breaking it up into 4 nibbles of 4 bits each. Each ofπ these nibbles is displayed as a Single hex Character 0-F.ππ Hex Representation XXXXπ ||||πHexStr := HexStr + Translate(Hi(W) shr 4); -----------||||πHexStr := HexStr + Translate(Hi(W) and 15);------------|||πHexStr := HexStr + Translate(Lo(W) shr 4); -------------||πHexStr := HexStr + Translate(Lo(W) and 15);--------------|πππNow the translate Function simply converts the decimal value ofπthe 4-bit nibble into an ascii hex value. if you look at anπascii Chart you will see how this is done:ππ'0' = 48 '5' = 53 'A' = 65π'1' = 49 '6' = 54 'B' = 66π'2' = 50 '7' = 55 'C' = 67π'3' = 51 '8' = 56 'D' = 68π'4' = 52 '9' = 57 'E' = 69π 'F' = 70πππAs you can see it easy For 0-9, you just add 48 to the value andπit's converted, but when you go to convert 10 to A, you need toπuse a different offset, so For values above 9 you add 55.ππFunction Translate(B : Byte) : Char;π beginπ if B < 10 thenπ Translate := Chr(B + 48)π elseπ Translate := Chr(B + 55);π end;π 15 05-28-9313:53ALL SWAG SUPPORT TEAM RANDOM1.PAS IMPORT 15 ₧8{ {Another method to acComplish this (which only requires an order of nπitterations is to generate an Array initialized from 2 to 1000 and thenπrandomize that Array. For your 400 numbers, just take 400 values in theπnew sequence (starting at the index of your lowest number). You can doπthat as follows:π}ππConst MaxNumber = 2000;πType SeqArray = Array [1..MaxNumber] of Integer;ππ{================================================================}πProcedure RandomizeSeq (first, last: Integer; Var iseq: SeqArray);π{================================================================}ππVar i, iran,π temp, imax : Integer;π r : Real;π{π Operation: A random number within the range 1..last is generatedπ on each pass and the upper limit of the random number generated isπ decreased by 1. The value stored at the highest index of the lastπ pass is moved to the location of the last number selected.ππ Parameters:π first = lowest number in sequence.π last = highest number in sequence.π iseq = Sequence Arrayπ}πbeginπ { initialize sequence Array }π For i := first to last do iseq[i] := i;π Randomize;π { randomize the sorted Array }π For imax := last downto first do beginπ { get a random number between 0 and 1 and scale up toπ an Integer in the range of first to last }π r := random;π iran := Trunc(r*imax) + first;π { replace With value at highest index }π temp := iseq[iran];π iseq[iran] := iseq[imax];π iseq[imax] := tempπ end;πend;ππ{ Example of generating 20 random numbers from 2 to 100: }ππVar i : Integer;π a : SeqArray;πbeginπ RandomizeSeq(2,100,a);π For i := 2 to 21 do Write(a[i]:3); Writeln;πend.π 16 05-28-9313:53ALL SWAG SUPPORT TEAM RANDOM2.PAS IMPORT 18 ₧8└| { MR> I have started playing With Borland Turbo Pascal 7.0 and I have aπ MR> problem. The Random routine is not the same as the one in TP 6.0.π MR> Using the same RandSeed, they generate different series of numbers.π MR> I have a couple of applications that depend upon the number seriesπ MR> generated by the TP 6.0 version. Can anyone supply me With theπ MR> algorithm used in the TP 6.0 Random routine? or maybe point me inπ MR> the right direction? I want to Construct my own TP 7 Random routineπ MR> that will behave as the one in TP 6.ππThe way both generators work is to update System.Randseed, then calculate theπnew random value from that one. There have been several different ways toπcalculate the value; I think TP 6 is different from TP 5.5, and TP 7 isπdifferent again. The update algorithm has been pretty Constant.ππAs I recall, you can simulate the TP 6 Random(N) Function in TP 7 as follows:π}πFunction TP6Random(N:Word):Word;πVarπ junk : Word;π myrandseed : Recordπ lo, hi : Wordπ end Absolute system.randseed;πbeginπ junk := Random(0); { Update Randseed }π TP6Random := myrandseed.hi mod N;πend;ππ{πYou might want to keep the following around in Case the update algorithm getsπchanged sometime in the future:ππDemonstration Program to show how the TP 6.0 random number generatorπupdates System.Randseed. Allows the seed to be cycled backwards. }ππProcedure CycleRandseed(cycles:Integer);π{ For cycles > 0, mimics cycles calls to the TP random number generator.π For cycles < 0, backs it up the given number of calls. }πVarπ i : Integer;πbeginπ if cycles > 0 thenπ For i := 1 to cycles doπ system.randseed := system.randseed*134775813 + 1π elseπ For i := -1 downto cycles doπ system.randseed := (system.randseed-1)*(-649090867);πend;ππVarπ i : Integer;πbeginπ randomize;π Writeln('Forwards:');π For i:=1 to 5 doπ Writeln(random);π Writeln('Backwards:');π For i:=1 to 5 doπ beginπ CycleRandseed(-1); { Back to previous value }π Writeln(random); { Show it }π CycleRandseed(-1); { Back up over it again }π end;πend.π 17 05-28-9313:53ALL SWAG SUPPORT TEAM REALFRMT.PAS IMPORT 8 ₧8╕▓ {π I recently came across the need For a way to dynamically Formatπ Real Variables For output - I came out With the following. (Youπ people following the Compiler thread may want this to make yourπ Compiler output pretty)ππ The routine checks to see how big the exponent is; if it's biggerπ than 1E7 or smaller than 1E-7, an unFormatted conversion is made.π if the number is less than 1E7 and greater than 1E-7, then aπ Formatted String is created. to make the output prettier, trailingπ zeros, periods and leading spaces are deleted.π}ππFunction FormatReal(r:Real):String;πVarπ s :String;ππbeginπ if ((r>1E-7) and (r<1E7))thenπ Str(r:12:12, s)π elseπ Str(r, s);ππ While s[ord(s[0])]='0' doπ Delete(s, ord(s[0]), 1);π While (s[1]=' ') doπ Delete(s, 1, 1);π if s[ord(s[0])]='.' thenπ Delete(s, ord(s[0]), 1);ππ FormatReal := s;πend;π 18 05-28-9313:53ALL SWAG SUPPORT TEAM REVERSE.PAS IMPORT 7 ₧8▓á {π a problem. I am asked to find the reverse of a positive Integer. Forπ example the reverse of 123 is 321 or the reverse of 1331 is 1331.π My teacher said that we should use div and MOD.π}ππVarπ X, Y: Integer;ππbeginπ X := PositiveInteger;π Y := 0;ππ While X > 0 doπ beginπ Y := (Y * 10) + (X mod 10);π X := X div 10;π end;ππ{πThe result will be in Y. Just so you do learn something of use out of this: Itπis a fact that the difference between two transposed (reversed) numbers will beπevenly divisible by 9. This can be of help if you are doing somethingπaccounting related and are trying to figure out why your numbers don't jive. ifπthe amount you are out is evenly divisible by 9, it is most likely aπtransposing error.π}π 19 05-28-9313:53ALL SWAG SUPPORT TEAM ROMAN1.PAS IMPORT 19 ₧8Z {π· Subject: Word to Roman Numeralππ OK, here is my second attempt, With error checking and all. Thanks toπTerry Moore <T.Moore@massey.ac.nz> For encouraging me. The last Functionπalso contained a couple of errors. This one is errorchecked.π}ππFunction RomantoArabic(Roman : String) : Integer;π{ Converts a Roman number to its Integer representation }π{ Returns -1 if anything is wrong }ππ Function Valueof(ch : Char) : Integer;π beginπ Case ch ofπ 'I' : Valueof:=1;π 'V' : Valueof:=5;π 'X' : Valueof:=10;π 'L' : Valueof:=50;π 'C' : Valueof:=100;π 'D' : Valueof:=500;π 'M' : Valueof:=1000;π else Valueof:=-1;π end;π end; { Valueof }ππ Function AFive(ch : Char) : Boolean; { Returns True if ch = 5,50,500 }π beginπ AFive:=ch in ['V','L','D'];π end; { AFive }ππVarπ Position : Byte;π TheValue, CurrentValue : Integer;π HighestPreviousValue : Integer;πbeginπ Position:=Length(Roman); { Initialize all Variables }π TheValue:=0;π HighestPreviousValue:=Valueof(Roman [Position]);π While Position > 0 doπ beginπ CurrentValue:=Valueof(Roman [Position]);π if CurrentValue<0 thenπ beginπ RomantoArabic:=-1;π Exit;π end;π if CurrentValue >= HighestPreviousValue thenπ beginπ TheValue:=TheValue+CurrentValue;π HighestPreviousValue:=CurrentValue;π endπ elseπ begin { if the digit precedes something larger }π if AFive(Roman [Position]) thenπ beginπ RomantoArabic:=-1; { A five digit can't precede anything }π Exit;π end;π if HighestPreviousValue div CurrentValue > 10 thenπ beginπ RomantoArabic:=-1; { e.g. 'XM', 'IC', 'XD'... }π Exit;π end;π TheValue:=TheValue-CurrentValue;π end;π Dec(Position);π end;π RomantoArabic:=TheValue;πend; { RomantoArabic }ππbeginπ Writeln('XXIV = ', RomantoArabic('XXIV'));π Writeln('DXIV = ', RomantoArabic('DXIV'));π Writeln('CXIV = ', RomantoArabic('CXIV'));π Writeln('MIXC = ', RomantoArabic('MIXC'));π Writeln('MXCIX = ', RomantoArabic('MXCIX'));π Writeln('LXVIII = ', RomantoArabic('LXVIII'));π Writeln('MCCXXIV = ', RomantoArabic('MCCXXIV'));π Writeln('MMCXLVI = ', RomantoArabic('MMCXLVI'));π Readln;πend. 20 05-28-9313:53ALL SWAG SUPPORT TEAM ROMAN2.PAS IMPORT 10 ₧8ß {π>Anyone know of how to make a Program that will convert anyπ>Integer entered into roman numeral Format?π}ππProgram Roman_Numeral_Test;ππTypeπ st_4 = String[4];π st_15 = String[15];π star_4 = Array[0..3] of st_4;π star_10 = Array[0..9] of st_4;ππConstπ Wunz : star_10 = ('', 'I', 'II', 'III', 'IV',π 'V', 'VI', 'VII', 'VIII', 'IX');ππ Tenz : star_10 = ('', 'X', 'XX', 'XXX', 'XL',π 'L', 'LX', 'LXX', 'LXXX', 'XC');ππ Hunz : star_10 = ('', 'C', 'CC', 'CCC', 'CD',π 'D', 'DC', 'DCC', 'DCCC', 'CM');ππ Thouz : star_4 = ('', 'M', 'MM', 'MMM');πππFunction Dec2Roman(wo_in : Word) : st_15;πbeginπ Dec2Roman := Thouz[(wo_in div 1000)] +π Hunz[((wo_in mod 1000) div 100)] +π Tenz[(((wo_in mod 1000) mod 100) div 10)] +π Wunz[(((wo_in mod 1000) mod 100) mod 10)]πend;ππVarπ wo_Temp : Word;ππbeginπ Writeln;π Write(' Enter number to be converted to roman-numeral equivalent: ');π readln(wo_Temp);π if (wo_Temp > 3999) thenπ wo_Temp := 3999;π Writeln;π Writeln(' Roman-numeral equivalent of ', wo_Temp, ' = ', Dec2Roman(wo_Temp))πend.ππ 21 05-28-9313:53ALL SWAG SUPPORT TEAM SHLSHR.PAS IMPORT 24 ₧85M { INFO ON SHR and SHL }ππ> (5 Shl 2) + 5 which is: (5 x 4) + 5π> So, 10 * 10 would be (10 Shl 3) + (10 Shl 1)ππThis looks good but, can it be done With Variables (So I can useπnumbers other than 5 & 5)?ππ Yes, just keep in mind that each shift leftward Doubles the value...ππ p SHL 1 = p * 2π p SHL 2 = p * 4π p SHL 3 = p * 8π p SHL 4 = p * 16π ...ππ (likewise, each shift rightward halves the value).ππ Also keep in mind that the maximum amount you can shift is theπ number of bits in the Variable. Bytes are 8 bits, Words andπ Integers are 16 bits, and LongInts are 32 bits. if you shiftπ a Variable its full bit size, or more, it will be 0 (zero).ππ For example: if p is a Byte, then p SHR 8 = 0.ππ{ Use Shr/Shl to multiply/divide, rather than the operatorsπ How do you (or anybody) do this? For example, how would I do 5 * 5?π}π{*******************************************************************}π Program DemoShifts;π Var Number, Result : Word;π beginπ { Calculate 5 * 5, without using multiplication ... }ππ Number := 5; { original value }π Result := Number SHL 2; { now Result = 4 * Number }π Result := Result + Number; { 4*Number + Number = 5*Number }ππ WriteLn( '5 * 5 = ', Result ); { because seeing is believing }ππ end {DemoShifts}.π{*******************************************************************}ππ But TP seems sometimes to do the 'shift vs. MUL optimization' itself,π this being bad if Compiling For a 386/486 CPU.π A "* 2" would always result in a SHL instruction ( unless Realπ arithmetic was used ;-> ).ππ Ok, I understand that part. if x shr 4 = x/4 (and the remainder isπ dropped) then I Really understand it. Does it? Do I?ππNo. x shl 0 = xπ x shl 1 = x/(2^1) = x/2π x shl 2 = x/(2^2) = x/4π x shl 3 = x/(2^3) = x/8π x shl 4 = x/(2^4) = x/16ππJust as:π x shr 0 = xπ x shr 1 = x*(2^1) = 2xπ x shr 2 = x*(2^2) = 4xπ x shr 3 = x*(2^3) = 8xπ x shr 4 = x*(2^4) = 16xππSo now you can see how and why the Compiler substitutes a "shr 1" For "* 2".ππ > PD> So, 10 * 10 would be: (10 shl 3) + 20π >π > MC> not quite:π > MC> (10 Shl 3)+(10 Shl 1)s, I'm back! (3:634/384.6)π >π > Why? wouldn't the second one take an additional instruction (shl)?ππWell yes, but 8086 instructions weren't created equal. PerForming twoπshifts and the add to combine them will (on a 286 or lesser) less timeπoverall than doing even one MUL.ππThe 386/486 has streamlined the MUL instruction so that it takes much lessπtime, and can often Compete With the shift/add approach. Which to use?πWell, I'd stick With the shift/add approach, since if you're writing oneπProgram For both XTs and 386s, the XT will be acceptable, and so will theπ386. Using the MUL; True, 386 perFormance will be better, but your XTπperFormance will suffer quite a bit.π 22 05-28-9313:53ALL SWAG SUPPORT TEAM SWAPNUMS.PAS IMPORT 5 ₧8Bë {π>Is there a way (using bit manipulations such as AND, OR, XOR) toπ>swap to Variables without making a 3rd temporary Variable?π>ππIf the two Variables are numbers, and the following operationsπwon't overflow the limitations of the Type, then yes, you canπdo it like this:π}πVarπ A, B : Integer;ππbeginπ A := 5;π B := 3;ππ A := A + B;π B := A - B;π A := A - B;ππ { which isππ A := 5 + 3 (8)π B := 8 - 3 (5)π A := 8 - 5 (3)ππ A = 3π B = 5 }ππend; 23 05-28-9313:53ALL SWAG SUPPORT TEAM TP6RAND.PAS IMPORT 12 ₧8└ {πBorland changed the Random() algorithm between TP6 and TP/BP7. The Unitπbelow provides the TP6 Random Function in its Integer flavour. (TheπRandomize Procedure wasn't changed.)ππ{ * Turbo Pascal Runtime Library Version 6.0 * ;π * Random Number Generator * ;π * * ;π * Copyright (C) 1988,92 Borland International * }ππUnit TP6Rand;ππInterfaceππFunction Random(Max: Integer): Integer;ππImplementationππConstπ { Scaling Constant}π ConstM31 = LongInt(-31);π { Multiplication factor}π Factor: Word = $8405;πππFunction NextRand: LongInt; Assembler;π{π Compute next random numberπ New := 8088405H * Old + 1π Out DX:AX = Next random numberπ}πAsmπ MOV AX,RandSeed.Word[0]π MOV BX,RandSeed.Word[2]π MOV CX,AXπ MUL Factor.Word[0] { New = Old.w0 * 8405H }π SHL CX,1 { New.w2 += Old.w0 * 808H }π SHL CX,1π SHL CX,1π ADD CH,CLπ ADD DX,CXπ ADD DX,BX { New.w2 += Old.w2 * 8405H }π SHL BX,1π SHL BX,1π ADD DX,BXπ ADD DH,BLπ MOV CL,5π SHL BX,CLπ ADD DH,BLπ ADD AX,1 { New += 1 }π ADC DX,0π MOV RandSeed.Word[0],AXπ MOV RandSeed.Word[2],DXπend;ππFunction Random(Max: Integer): Integer; Assembler;πAsmπ CALL NextRandπ xor AX,AXπ MOV BX,Max.Word[0]π or BX,BXπ JE @@1π XCHG AX,DXπ div BXπ XCHG AX,DXπ@@1:πend;ππend.π 24 05-28-9313:53ALL SWAG SUPPORT TEAM WORD2HEX.PAS IMPORT 67 ₧8è╘ {π> How does the following Function make a Word into Hex:ππ - Dissection:π}ππTypeπ Str4 : String[4];ππFunction WordtoHex(W : Word) : St4πVarπ HexStr : St4;ππ Function Translate(B : Byte) : Char;ππ { This Function takes a number from 0 to 15 and makes it into a hex digit.}ππ beginπ if B < 10 thenπ { if it's 0..9 }π Translate := Chr(B + 48)π { These statements use math on Characters... ascii 48 is '0'.π Could have been written: Translate := Chr(B + ord('0')) }π elseπ Translate := Chr(B + 55);π { This one is For letters A~F. ascii 55 isn't anything, but if you addπ $A (10) to 55 you get 65, which is the ascii code For 'A'π This could have been written: Translate := Chr(B + ord('A')-$A); }π end;ππbeginπ HexStr := ' ';π HexStr := HexStr + Translate(Hi(W) shr 4);π { Hi(W) takes the high Byte of Word W.π shr 4 means the same as divide by 16...π What they're Really doing here is taking each nibble of the hex Wordπ and isolating it, translating it to hex, and adding it to the String. }π HexStr := HexStr + Translate(Hi(W) and 15);π HexStr := HexStr + Translate(Lo(W) shr 4);π HexStr := HexStr + Translate(Lo(W) and 15);π WordtoHex := HexStr;πend;π{π> I am learning Pascal and don't understand something. Howπ> does the following Function make a Word into Hex:ππIt doesn't, at least not as present! But if you changes two things, maybeπspelling-errors, it will work. This is a bit hard to explain and grasp, becauseπit involves operations at a less abstract level than the one that you usuallyπwork on in TP. Remember, when a number is stored in memory, it's stored binary,πhexadecimal notion is just For making it easier For man to read. I don't knowπif you know how to Write and read binary- and hexadecimal-numbers, in Case youπdon't know it's all here...ππOn PC, a Word, in the range 0 to 65535, has 16 bits. A Word written in binaryπnotion For this reason contains 16 digits, 0's or 1's! But a Word written inπhexadecimal notion contains 4 digits. Simple math tells us that one digit inπhex-notion is equal to four digits binary. Four digits binary gives 16πcombinations (2^4). ThereFore, each hexadecimal digit must be able to containπvalues from decimal 0-decimal 15, _in one digit_! Our normal digits, 0-9, isn'tπsufficient For this, we must use 6 other digits. The designers of this systemπchoosed A-F as the extra digits. This means, in hex the digits are 0, 1, 2, 3,π4, 5, 6, 7, 8, 9, A, B, C, D, E and F. Hanging on?ππ> Function WordtoHex(W : Word) : St4ππCompile-time error: You must have a semicolon after the Function header-line.ππ> Varπ> HexStr : St4;ππ> Function Translate(B : Byte) : Char;π> beginπ> if B < 10π> thenπ> Translate := Chr(B + 48)π> elseπ> Translate := Chr(B + 55);π> end;ππThis is clearer as:ππ if b < 10π then Translate := Chr(b+ord('0'))π else Translate := Chr(b+ord('A')-10);ππThink about the first Case, when b < 10, if b were 0, the expression would beπ'0' plus 0, '0'!. if b were 1, it's '0' plus 1, '1'!. This works because in theπASCII-table the numbers are sequential ordered. But '0' plus 10 would be ':',πbecause it happens to be after the numbers.ππthen, when we want 'A'-'F, we would need to start from 'A'. But we can't add 10πto 'A' For getting 'A' and 11 For getting 'B' and that like. First we must makeπthe value relative 'A'. Because the values that we're working on here is in theπrange 10 to 15, we can decrease it With 10 and get 0 to 5. then is OK to useπthem relative 'A'. As beFore, 'A' plus 0 is 'A', 'A' plus 1 is 'B', and so on.ππHowever, this routine has no safety check, it will gladly return 'G' For 16,πbecause 'A'+6 is 'G'. It doesn't care if the value is within hexadecimal rangeπor not (numbers bigger than 15 can't be turned into one hex digit, they needπmore digits). But here it's OK, because the routine is local to WordtoHex thatπwill never pass anything else than 0 to 15.ππ> beginπ> HexStr := ' ';ππLogical error: You must initalize HexStr to an empty String, '', if not it willπconsist of a space and three hex digits, not four. A hex-Word String isπComposed of four hexadeciamal-digits. Because you have declared the String as aπVariable of the Type St4 and St4 only allows four Chars, exactly what is neededπFor a hexWord-String, the last one added will be discarded if you have a spaceπat the beginning, filling up one position.ππ> HexStr := HexStr + Translate(Hi(W) shr 4);π> HexStr := HexStr + Translate(Hi(W) and 15);π> HexStr := HexStr + Translate(Lo(W) shr 4);π> HexStr := HexStr + Translate(Lo(W) and 15);π> WordtoHex := HexStr;π> end;ππIt would be easier to read if the 'and'-value were in hex-notation, $000F. Seeπbelow For explanation why. However, this part requires some understanding ofπthe bits. It's probably best show With an example. Let's say, our number W isπ$1234.ππ$1234 is written 0001 0010 0011 0100 in binary. Each hex-digit corresponds to aπfour-group binary digits.ππ■) The binary number 0001 is 0*(2^3) + 0*(2^2) + 0*(2^1) + 1*(2^0). It givesπ0+0+0+1=1 in decimal.ππ■) The binary number 0101 is 0*(2^3) + 1*(2^2) + 0*(2^1) + 1*(2^0). It givesπ0+4+0+1=5 in decimal.ππ■ The _decimal_ number 1101 is 1*(10^3) + 1*(10^2) + 0*(10^1) + 1*(10^0). Itπgives 1000+100+0+1=1011! As you can see, the only difference between theπdecimal and the binary and the hexadecimal system is the base-power. True, theπhex-system Uses strange digits For us used to decimal, but For the ones used toπbinary, 2-9 is equally strange...ππLike our decimal system, in hex and binary, it's unnescessary to includeπleading zeros, i. e. $0001 = $1 (of course you can't remove trailing zeroes,πdecimal 1000 certainly isn't equal to decimal 1...). But you will note that Iπsometimes include these leading zeroes, just because it looks good (?). andπwriting binary number 1000 0000 is like writing 10000 in decimal as 10,000;πit's only For easy reading, but the Compiler won't allow it.ππHowever, I hope you grasp a least something of my extremly bad explanation :-(,πor maybe you know it beFore?! Now, let's look at the things that happens whenπthe above statements are executed and w = $1234 (0001 0010 0011 0100).ππHi returns the upper 8 bits of the Word, in this Case 0001 0010; Lo returns theπlower bits (!), 0011 0100. The above code Uses 'and' and 'shr', a breifπexplanation of them will probably be nescessary (oh no :-)).ππ■ and, when not used as a Boolean operator, Uses two binary numbers and, Forπeach bit, tests them. if _both_ bits are set (equal to 1) the resuling bit isπset to 1, if any or both of them is cleared (equal to 0) the result is 0. Thisπmeans:πππ 0001 0010 Hi(w) 0011 0100 Lo(w)π 0000 1111 and With 15 or $000F 0000 1111 and With 15 or $000Fπ --------- ---------π 0000 0010 0010 binary = 2 hex 0000 0100 0100 binary = 4 hexππThis was the second and first statement, and out you get the second and firstπnumber! When we pass them to Translate, we get back '2' and '4'.ππ■ shr, only For binary operations, shifts the bits to the right. The bits thatπpasses over the right side is lost, and the ones that move on left side isπreplaced by zeroes. The bits shifts as many times as the value after theπshr-keyWord, here 4 times. Like this:ππ 00010010 Hi(w) 00110100 Lo(w)π -------- shr 4 --------π 00001001 after one shift 00011010π 00000100 after two shifts 00001101π 00000010 after three shifts 00000110π 00000001 after four shifts 00000011ππNow we got binary 0001 and binary 0011, in hex $1 and $3. The first and thirdπstatement, and the first and third number! The String to return is digit1 +πdigit2 + digit3 + digit4, exactly what we want.ππHmm... Now I haven't told you anything about the binary or, xor, not andπshl-keyWords... But I think this message is quiet long as it is, without that.πBut if you want more info or a better explanation, only drop me a msg here.ππHappy hacking /Jake 930225 17.35 (started writing last night)πPS. There may be some errors, I haven't proof-read the Text or my math. then,πplease correct me, anybody.π} 25 08-27-9320:03ALL SEAN PALMER Handling Numbers in ASM IMPORT 9 ₧8H { SEAN PALMERππI've been playing around with the AAM instruction and came up with someπthings you guys might find useful...ππStrings as function results are WIERD with the inline Assembler. 8)π}ππfunction div10(b : byte) : byte; assembler;πasmπ mov al, bπ aamπ mov al, ahπend;ππfunction mod10(b : byte) : byte; assembler;πasmπ mov al, bπ aamπend;ππtypeπ str2 = string[2];π str8 = string[8];ππfunction toStr2(b : byte) : str2; assembler;πasm {only call with b=0~99}π les di, @RESULTπ cldπ mov al, 2π stosbπ mov al, bπ aamπ xchg ah, alπ add ax, $3030π stoswπend;ππ{makes date string in MM/DD/YY format from m,d,y}πfunction toDateStr(m,d,y:byte):str8;assembler;asm {only call with m,d,y=0~99}π les di, @RESULTπ cldπ mov al, 8π stosbπ mov al, mπ aamπ xchg ah, alπ add ax, $3030π stoswπ mov al, '/'π stosbπ mov al, dπ aamπ xchg ah, alπ add ax, $3030π stoswπ mov al, '/'π stosbπ mov al, yπ aamπ xchg ah, alπ add ax, $3030π stoswπend;πππ 26 08-27-9321:39ALL TREVOR CARLSON MS to IEEE Numbers IMPORT 9 ₧8 {πTrevor Carlsonππ> Does anyone have source examples of how to convert an MSBIN to aπ> LongInt Type Variable?π}ππTypeπ MKS = Array [0..3] of Byte;ππFunction MStoIEEE(Var MS) : Real;π{ Converts a 4 Byte Microsoft format single precision Real Variable asπ used in earlier versions of QuickBASIC and GW-BASIC to IEEE 6 Byte Real }πVarπ m : MKS Absolute MS;π r : Real;π ieee : Array [0..5] of Byte Absolute r;πbeginπ FillChar(r, sizeof(r), 0);π ieee[0] := m[3];π ieee[3] := m[0];π ieee[4] := m[1];π ieee[5] := m[2];π MStoieee := r;πend; { MStoIEEE }πππFunction IEEEtoMS(ie : Real) : LongInt;π{ LongInt Type used only For convenience of Typecasting. Note that this willπ only be effective where the accuracy required can be obtained in the 23π bits that are available With the MKS Type. }πVarπ ms : MKS;π ieee : Array [0..5] of Byte Absolute ie;πbeginπ ms[3] := ieee[0];π ms[0] := ieee[3];π ms[1] := ieee[4];π ms[2] := ieee[5];π IEEEtoMS := LongInt(ms);πend; { IEEEtoMS }π 27 08-27-9321:41ALL LOU DUCHEZ Convert number Base IMPORT 22 ₧8 {πLOU DUCHEZππ>does andbody know an easy way to convert a Byte value from it's Integerπ> notation to hex notatation?ππWell, thank you For this message. It finally got me off my keister (sp?) toπWrite a "decimal-to-hex" converter -- a project I'd been meaning to do, butπnever got around to. (Technically, since I was in a seated position, Iπremained on my keister the whole time, but you know what I mean). Actually,πthe following is not just "decimal-to-hex" -- it's decimal-to-any-base-from-π2-to-36-converter (because base 1 and below doesn't make sense, and afterπbase 36 I run out of alphabet to represent "digits"). Here is NUBASE:π}πππFunction nubase(numin : LongInt; base, numplaces : Byte) : String;πVarπ tmpstr : String;π remainder : Byte;π negatize : Boolean;πbeginπ negatize := (numin < 0); { Record if it's a negative number }π if negatize thenπ numin := abs(numin); { convert to positive For calcs }π tmpstr[0] := Char(numplaces); { set length of the output String }ππ While numplaces > 0 doπ begin { Loop: fills each space in String }π remainder := numin mod base; { get next "digit" (under new base) }π if remainder > 9 thenπ tmpstr[numplaces] := Char(remainder + 64 - 9) { convert to letter }π elseπ tmpstr[numplaces] := Char(remainder + 48); { use number as is }π numin := numin div base; { reduce dividend For next "pass" }π numplaces := numplaces - 1; { go to "next" position in String }π end; { end of loop }ππ { The following: if we've run out of room on the String, or if it's aπ negative number and there's not enough space For the "minus" sign,π convert the output String to all asterisks. }ππ if (numin <> 0) or (negatize and (tmpstr[1] <> '0')) thenπ For numplaces := 1 to Byte(tmpstr[0]) doπ tmpstr[numplaces] := '*';ππ { add minus sign }ππ if negatize and (tmpstr[1] = '0') thenπ tmpstr[1] := '-';ππ nubase := tmpstr;πend;πππ{πFeed it the number to convert, the base to convert into, and the number ofπspaces you want For it. Leading zeros will be provided. Example: toπconvert 111 into hex (base 16) and give 4 digits of answer, you could say:ππWriteln(nubase(111, 16, 4))ππand it'd Write out:ππ006FππThis routine does handle negative numbers too. if you don't give it enoughπ"space" in the third parameter you pass, it'll return all asterisks. Forπlaughs, try converting the number 111 into base 10 and giving it 5 digitsπof answer. You'll get:ππ00111 (predictably enough)π} 28 11-02-9305:00ALL CHRIS QUARTETTI Setting/Getting BITS SWAG9311 21 ₧8 {πCHRIS QUARTETTIππ>Is there an easy way to create a 1-bit or 2-bit data structure. Forπ>example, a 2-bit Type that can hold 4 possible values. For that matter,π>is there a hard way? <g> Thanks very much -Gregππ I suppose this would qualify For the hard way-- not too flexible, but itπworks. It would be a bit easier to do this if you wanted a bunch of the sameπsize Variables (ie 4 4 bit Variables, or an Array of 4*x 4 bit Variables).πFWIW I used BP7 here, but TP6 and up will work. Also, it need not be Objectπoriented.π}ππTypeπ bitf = Object { split 'bits' into bitfields }π bits : Word; { 16 bits total }ππ Function get : Word;ππ Procedure set1(value : Word); { this will be 2 bits }π Function get1 : Word;ππ Procedure set2(value : Word); { this will be 13 bits }π Function get2 : Word;ππ Procedure set3(value : Word); { this will be 1 bit }π Function get3 : Word;π end;ππFunction bitf.get : Word;πbeginπ get := bits;πend;ππProcedure bitf.set1(value : Word);π{ Set the value of the first bitfield }πConstπ valmask : Word = $C000; { 11000000 00000000 }π bitsmask : Word = $3FFF; { 00111111 11111111 }πbeginπ value := value shl 14 and valmask;π bits := value + (bits and bitsmask);πend;ππFunction bitf.get1 : Word;π{ Get the value of the first bitfield }πbeginπ get1 := bits shr 14;πend;ππProcedure bitf.set2(value : Word);π{ Set the value of the second bitfield }πConstπ valmask : Word = $3FFE; { 00111111 11111110 }π bitsmask : Word = $C001; { 11000000 00000001 }πbeginπ value := (value shl 1) and valmask;π bits := value + (bits and bitsmask);πend;ππFunction bitf.get2 : Word;π{ Get the value of the second bitfield }πConstπ valmask : Word = $3FFE; { 00111111 11111110 }πbeginπ get2 := (bits and valmask) shr 1;πend;ππProcedure bitf.set3(value : Word);π{ Set the value of the third bitfield }πConstπ valmask : Word = $0001; { 00000000 00000001 }π bitsmask : Word = $FFFE; { 11111111 11111110 }πbeginπ value := value and valmask;π bits := value + (bits and bitsmask);πend;ππFunction bitf.get3 : Word;π{ Get the value of the third bitfield }πConstπ valmask : Word = $0001; { 00000000 00000001 }πbeginπ get3 := bits and valmask;πend;ππVarπ x : bitf;ππbeginπ x.set1(3); { set all to maximum values }π x.set2(8191);π x.set3(1);π Writeln(x.get1, ', ', x.get2, ', ', x.get3, ', ', x.get);πend.π 29 11-21-9309:24ALL GREG VIGNEAULT Base Notation SWAG9311 21 ₧8 π{ How about a procedure that will display any integer in any baseπ notation from 2 to 16? The following example displays the valuesπ 0 through 15 in binary (base 2), octal (base 8), decimal (base 10)π and hexadecimal (base 16) notations ... }ππ(********************************************************************)πPROGRAM BaseX; (* compiler: Turbo Pascal v4.0+ *)π (* Nov.14.93 Greg Vigneault *)π(*------------------------------------------------------------------*)π(* Display any INTEGER in any base notation from 2 to 16... *)π(* *)π(* number base 2 = binary notation (digits 0,1) *)π(* number base 8 = octal notation (digits 0..7) *)π(* number base 10 = decimal notation (digits 0..9) *)π(* number base 16 = hexadecimal notation (digits 0..9,A..F) *)ππPROCEDURE DisplayInteger (AnyInteger :INTEGER; NumberBase :BYTE);π CONST DataSize = 16; (* bit-size of an INTEGER *)π VAR Index : INTEGER;π Digit : ARRAY [1..DataSize] OF CHAR;π BEGINπ IF (NumberBase > 1) AND (NumberBase < 17) THEN BEGINπ Index := 0;π REPEATπ INC (Index);π Digit [Index] := CHR(AnyInteger MOD NumberBase + ORD('0'));π IF (Digit [Index] > '9') THEN INC (Digit [Index],7);π AnyInteger := AnyInteger DIV NumberBase;π UNTIL (AnyInteger = 0) OR (Index = DataSize);π WHILE (Index > 0) DO BEGINπ Write (Digit [Index]);π DEC (Index);π END; {WHILE Index}π END; {IF NumberBase}π END {DisplayInteger};ππ(*------------------------------------------------------------------*)π(* to test the DisplayInteger procedure... *)ππVAR Base, Number : INTEGER;ππBEGINπ FOR Base := 2 TO 16 DOπ CASE Base OFπ 2,8,10,16 : BEGINπ WriteLn;π CASE Base OFπ 2 : Write ('Binary : ');π 8 : Write ('Octal : ');π 10 : Write ('Decimal: ');π 16 : Write ('Hex : ');π END; {CASE}π FOR Number := 0 TO 15 DO BEGINπ DisplayInteger (Number, Base);π Write (' ');π END; {FOR}π END;π END; {CASE}π WriteLn;ππEND {BaseX}.π 30 11-02-9305:52ALL GREG VIGNEAULT LongInt to HEX SWAG9311 11 ₧8 {πGREG VIGNEAULTππ> So to assign the File I will need the HEX in String format.π}ππTypeπ String8 = String[8];ππVarπ MyStr : String8;π ALong : LongInt;ππ{ convert a LongInt value to an 8-Character String, using hex digits }π{ (using all 8 Chars will allow correct order in a sorted directory) }ππProcedure LongToHex(AnyLong : LongInt; Var HexString : String8);πVarπ ch : Char;π Index : Byte;πbeginπ HexString := '00000000'; { default to zero }π Index := Length(HexString); { String length }π While AnyLong <> 0 doπ begin { loop 'til done }π ch := Chr(48 + Byte(AnyLong) and $0F); { 0..9 -> '0'..'9' }π if ch > '9' thenπ Inc(ch, 7); { 10..15 -> 'A'..'F'}π HexString[Index] := ch; { insert Char }π Dec(Index); { adjust chr Index }π AnyLong := AnyLong SHR 4; { For next nibble }π end;πend;ππbeginπ ALong := $12345678; { a LongInt value }π LongToHex(ALong, MyStr); { convert to hex str}π WriteLn;π WriteLn('$', MyStr); { display the String}π WriteLn;πend.π 31 10-28-9311:32ALL GREG VIGNEAULT Verify ISBN Numbers SWAG9311 17 ₧8 {===========================================================================πDate: 09-22-93 (20:14)πFrom: GREG VIGNEAULTπSubj: Pascal ISBN verificationππ Here's a snippet of TP code for the free SWAG archives. It verifiesπ ISBN numbers, via the embedded checksum ... }ππ(********************************************************************)π(* Turbo/Quick/StonyBrook Pascal source file: ISBN.PAS v1.0 GSV *)π(* Verify any International Standard Book Number (ISBN) ... *)ππPROGRAM checkISBN;ππCONST TAB = #9; { ASCII horizontal tab }π LF = #10; { ASCII line feed }ππVAR ISBNstr : STRING[16];π loopc, ISBNlen, M, chksm : BYTE;ππBEGIN {checkISBN}ππ WriteLn (LF,TAB,'ISBN Check v1.0 Copyright 1993 Greg Vigneault',LF);ππ IF ( ParamCount <> 1 ) THEN BEGIN { we want just one input parm }π WriteLn ( TAB, 'Usage: ISBN <ISBN#>', LF );π Halt(1);π END; {IF}ππ ISBNstr := ParamStr (1); { get the ISBN number }π Write ( TAB, 'Checking ISBN# ', ISBNstr, ' ...' );π { eliminate any non-digit characters from the ISBN string... }π ISBNlen := 0;π FOR loopc := 1 TO ORD ( ISBNstr[0] ) DOπ IF ( ISBNstr[ loopc ] IN ['0'..'9'] ) THEN BEGINπ INC ( ISBNlen );π ISBNstr[ ISBNlen ] := ISBNstr[ loopc ];π END; {IF & FOR}π { an 'X' at the end of the ISBN affects the result... }π IF ( ISBNstr[ ORD ( ISBNstr[0] ) ] IN ['X','x'] ) THENπ M := 10π ELSEπ M := ORD ( ISBNstr[ ISBNlen ] ) - 48;π ISBNstr[0] := CHR ( ISBNlen ); { new ISBN string length }π WriteLn ( 'reduced ISBN = ', ISBNstr ); WriteLn;π chksm := 0; { initialize checksum }π FOR loopc := 1 TO ISBNlen-1 DOπ INC (chksm, ( ORD ( ISBNstr[ loopc ] ) - 48 ) * loopc );π Write ( TAB, 'ISBN ' );π IF ( ( chksm MOD 11 ) = M ) THENπ WriteLn ( 'is okay.' )π ELSEπ WriteLn ( 'error!',#7 );ππEND {checkISBN}. (* Not for commercial retail. *)π 32 10-28-9311:31ALL J.P. RITCHEY MSBIN to IEEE SWAG9311 70 ₧8 {===========================================================================πDate: 10-09-93 (23:23)πFrom: J.P. RitcheyπSubj: MSBIN to IEEEπ---------------------------------------------------------------------------πGE> Does anyone have any code for Converting MSBIN formatπGE> numbers into IEEE? }ππ{$A-,B-,D-,E+,F-,I-,L-,N+,O-,R-,S-,V-}πunit BFLOAT;π(*π MicroSoft Binary Float to IEEE format Conversionπ Copyright (c) 1989 J.P. Ritcheyπ Version 1.0ππ This software is released to the public domain. Thoughπ tested, there could be some errors. Any reports of bugsπ discovered would be appreciated. Send reports toπ Pat Ritchey Compuserve ID 72537,2420π*)πinterfaceππtypeπ bfloat4 = recordπ { M'Soft single precision }π mantissa : array[5..7] of byte;π exponent : byte;π end;ππ Bfloat8 = recordπ { M'Soft double precision }π mantissa : array[1..7] of byte;π exponent : byte;π end;πππFunction Bfloat4toExtended(d : bfloat4) : extended;πFunction Bfloat8toExtended(d : Bfloat8): extended;ππ{ These routines will convert a MicroSoft Binary Floating pointπ number to IEEE extended format. The extended is large enoughπ to store any M'Soft single or double number, so no over/underflowπ problems are encountered. The Mantissa of an extended is large enoughπ to hold a BFloatx mantissa, so no truncation is required.ππ The result can be returned to TP single and double variables andπ TP will handle the conversion. Note that Over/Underflow can occurπ with these types. }ππFunction HexExt(ep:extended) : string;ππ{ A routine to return the hex representation of an IEEE extended variableπ Left in from debugging, you may find it useful }ππFunction ExtendedtoBfloat4(ep : extended; var b : bfloat4) : boolean;πFunction ExtendedtoBfloat8(ep : extended; var b : Bfloat8) : boolean;ππ{ These routines are the reverse of the above, that is they convertπ TP extended => M'Soft format. You can use TP singles and doublesπ as the first parameter and TP will do the conversion to extendedπ for you.ππ The Function result returns True if the conversion was succesful,π and False if not (because of overflow).ππ Since an extended can have an exponent that will not fitπ in the M'Soft format Over/Underflow is handled in the followingπ manner:π Overflow: Set the Bfloatx to 0 and return a False result.π Underflow: Set the BFloatx to 0 and return a True Result.ππ No rounding is done on the mantissa. It is simply truncated toπ fit. }πππFunction BFloat4toReal(b:bfloat4) : Real;πFunction BFloat8toReal(b:bfloat8) : Real;ππ{ These routines will convert a MicroSoft Binary Floating pointπ number to Turbo real format. The real is large enoughπ to store any M'Soft single or double Exponent, so no over/underflowπ problems are encountered. The Mantissa of an real is large enoughπ to hold a BFloat4 mantissa, so no truncation is required. Theπ BFloat8 mantissa is truncated (from 7 bytes to 5 bytes) }ππFunction RealtoBFloat4(rp: real; var b:bfloat4) : Boolean;πFunction RealtoBFloat8(rp : real; var b:bfloat8) : Boolean;ππ{ These routines do the reverse of the above. No Over/Underflow canπ occur, but truncation of the mantissa can occurπ when converting Real to Bfloat4 (5 bytes to 3 bytes).ππ The function always returns True, and is structured this way toπ function similar to the IEEE formats }ππimplementationπtypeπ IEEEExtended = recordπ Case integer ofπ 0 : (Mantissa : array[0..7] of byte;π Exponent : word);π 1 : (e : extended);π end;ππ TurboReal = recordπ Case integer ofπ 0 : (Exponent : byte;π Mantissa : array[3..7] of byte);π 1 : (r : real);π end;ππFunction HexExt(ep:extended) : string;πvarπ e : IEEEExtended absolute ep;π i : integer;π s : string;π Function Hex(b:byte) : string;π const hc : array[0..15] of char = '0123456789ABCDEF';π beginπ Hex := hc[b shr 4]+hc[b and 15];π end;πbeginπ s := hex(hi(e.exponent))+hex(lo(e.exponent))+' ';π for i := 7 downto 0 do s := s+hex(e.mantissa[i]);πHexExt := s;πend;ππFunction NullMantissa(e : IEEEextended) : boolean;πvarπ i : integer;πbeginπNullMantissa := False;πfor i := 0 to 7 do if e.mantissa[i] <> 0 then exit;πNullMantissa := true;πend;ππProcedure ShiftLeftMantissa(var e);π{ A routine to shift the 8 byte mantissa left one bit }πinline(π{0101} $F8/ { CLC }π{0102} $5F/ { POP DI }π{0103} $07/ { POP ES }π{0104} $B9/$04/$00/ { MOV CX,0004 }π{0107} $26/$D1/$15/ { RCL Word Ptr ES:[DI],1 }π{010A} $47/ { INC DI }π{010B} $47/ { INC DI }π{010C} $E2/$F9 { LOOP 0107 }π);ππProcedure Normalize(var e : IEEEextended);π{ Normalize takes an extended and insures that the "i" bit isπ set to 1 since M'Soft assumes a 1 is there. An extended hasπ a value of 0.0 if the mantissa is zero, so the first check.π The exponent also has to be kept from wrapping from 0 to $FFFFπ so the "if e.exponent = 0" check. If it gets this smallπ for the routines that call it, there would be underflow and 0π would be returned.π}πvarπ exp : word;ππbeginπexp := e.exponent and $7FFF; { mask out sign }πif NullMantissa(e) thenπ beginπ E.exponent := 0;π exitπ end;πwhile e.mantissa[7] < 128 doπ beginπ ShiftLeftMantissa(e);π dec(exp);π if exp = 0 then exit;π end;πe.exponent := (e.exponent and $8000) or exp; { restore sign }πend;ππFunction Bfloat8toExtended(d : Bfloat8) : extended;πvarπ i : integer;π e : IEEEExtended;πbeginπ fillchar(e,sizeof(e),0);π Bfloat8toExtended := 0.0;π if d.exponent = 0 then exit;π { if the bfloat exponent is 0 the mantissa is ignored andπ the value reurned is 0.0 }π e.exponent := d.exponent - 129 + 16383;π { bfloat is biased by 129, extended by 16383π This creates the correct exponent }π if d.mantissa[7] > 127 thenπ { if the sign bit in bfloat is 1 then set the sign bit in the extended }π e.exponent := e.exponent or $8000;π move(d.Mantissa[1],e.mantissa[1],6);π e.mantissa[7] := $80 or (d.mantissa[7] and $7F);π { bfloat assumes 1.fffffff, so supply it for extended }π Bfloat8toExtended := e.e;πend;ππFunction Bfloat4toExtended(d : bfloat4) : extended;πvarπ i : integer;π e : IEEEExtended;πbeginπ fillchar(e,sizeof(e),0);π Bfloat4toExtended := 0.0;π if d.exponent = 0 then exit;π e.exponent := integer(d.exponent - 129) + 16383;π if d.mantissa[7] > 127 thenπ e.exponent := e.exponent or $8000;π move(d.Mantissa[5],e.mantissa[5],2);π e.mantissa[7] := $80 or (d.mantissa[7] and $7F);π Bfloat4toExtended := e.e;πend;ππFunction ExtendedtoBfloat8(ep : extended; var b : Bfloat8) : boolean;πvarπ e : IEEEextended absolute ep;π exp : integer;π sign : byte;πbeginπFillChar(b,Sizeof(b),0);πExtendedtoBfloat8 := true; { assume success }πNormalize(e);πif e.exponent = 0 then exit;πsign := byte(e.exponent > 32767) shl 7;πexp := (e.exponent and $7FFF) - 16383 + 129;πif exp < 0 then exp := 0; { underflow }πif exp > 255 then { overflow }π beginπ ExtendedtoBfloat8 := false;π exit;π end;πb.exponent := exp;πmove(e.mantissa[1],b.mantissa[1],7);πb.mantissa[7] := (b.mantissa[7] and $7F) or sign;πend;ππFunction ExtendedtoBfloat4(ep : extended; var b : Bfloat4) : boolean;πvarπ e : IEEEextended absolute ep;π exp : integer;π sign : byte;πbeginπFillChar(b,Sizeof(b),0);πExtendedtoBfloat4 := true; { assume success }πNormalize(e);πif e.exponent = 0 then exit;πsign := byte(e.exponent > 32767) shl 7;πexp := (e.exponent and $7FFF) - 16383 + 129;πif exp < 0 then exp := 0; { underflow }πif exp > 255 then { overflow }π beginπ ExtendedtoBfloat4 := false;π exit;π end;πb.exponent := exp;πmove(e.mantissa[5],b.mantissa[5],3);πb.mantissa[7] := (b.mantissa[7] and $7F) or sign;πend;ππFunction BFloat4toReal(b:bfloat4) : Real;πvarπ r : TurboReal;πbeginπ fillchar(r,sizeof(r),0);π r.exponent := b.exponent;π move(b.mantissa[5],r.mantissa[5],3);π Bfloat4toReal := r.r;πend;ππFunction BFloat8toReal(b:bfloat8) : Real;πvarπ r : TurboReal;πbeginπ fillchar(r,sizeof(r),0);π r.exponent := b.exponent;π move(b.mantissa[3],r.mantissa[3],5);π Bfloat8toReal := r.r;πend;ππFunction RealtoBFloat4(rp: real; var b:bfloat4) : Boolean;πvarπ r : TurboReal absolute rp;πbeginπ fillchar(b,sizeof(b),0);π b.exponent := r.exponent;π move(r.mantissa[5],b.mantissa[5],3);π RealtoBfloat4 := true;πend;ππFunction RealtoBFloat8(rp : real; var b:bfloat8) : Boolean;πvarπ r : TurboReal absolute rp;πbeginπ fillchar(b,sizeof(b),0);π b.exponent := r.exponent;π move(r.mantissa[3],b.mantissa[3],5);π RealtoBfloat8 := true;πend;ππend.π 33 09-26-9310:53ALL KENT BRIGGS Random Number Generator SWAG9311 8 ₧8 (*πFrom: KENT BRIGGS Refer#: NONEπSubj: TP 7.0 RANDOM GENERATOR Conf: (1221) F-PASCALπ*)ππconstπ rseed: longint = 0;ππprocedure randomize67; {TP 6.0 & 7.0 seed generator}πbeginπ reg.ah:=$2c;π msdos(reg); {get time: ch=hour,cl=min,dh=sec,dl=sec/100}π rseed:=reg.dx;π rseed:=(rseed shl 16) or reg.cx;πend;ππfunction rand_word6(x: word): word; {TP 6.0 RNG: word}πbeginπ rseed:=rseed*134775813+1;π rand_word6:=(rseed shr 16) mod x;πend;ππfunction rand_word7(x: word): word; {TP 7.0 RNG: word}πbeginπ rseed:=rseed*134775813+1;π rand_word7:=((rseed shr 16)*x+((rseed and $ffff)*x shr 16)) shr 16;πend;ππfunction rand_real67: real; {TP 6.0 & 7.0 RNG: real}πbeginπ rseed:=rseed*134775813+1;π if rseed<0 then rand_real67:=rseed/4294967296.0+1.0 elseπ rand_real67:=rseed/4294967296.0;πend;π 34 09-26-9309:31ALL MARTIN RICHARDSON Get HIGH order of WORD SWAG9311 7 ₧8 {*****************************************************************************π * Function ...... wHi()π * Purpose ....... Return the High order word from a longint (double word)π * Parameters .... n LONGINT to retrieve high word fromπ * Returns ....... High word from nπ * Notes ......... HI only returns the HIgh byte from a word. I neededπ * something that returned the high WORD from a LONGINT.π * Author ........ Martin Richardsonπ * Date .......... October 9, 1992π *****************************************************************************}πFUNCTION wHi( n: LONGINT ): WORD; ASSEMBLER;πASMπ MOV AX, WORD PTR n[2]πEND;ππ 35 09-26-9309:31ALL MARTIN RICHARDSON Get Low Order of WORD SWAG9311 7 ₧8 {*****************************************************************************π * Function ...... wLo()π * Purpose ....... Return the low order word from a longint (double word)π * Parameters .... n LONGINT to retrieve low word fromπ * Returns ....... Low word from nπ * Notes ......... LO only returns the LOw byte from a word. I neededπ * something that returned the low WORD from a LONGINT.π * Author ........ Martin Richardsonπ * Date .......... October 9, 1992π *****************************************************************************}πFUNCTION wLo( n: LONGINT ): WORD; ASSEMBLER;πASMπ MOV AX, WORD PTR n[0]πEND;ππ 36 11-02-9305:01ALL ROBERT ROTHENBURG More Get/Set Bits SWAG9311 21 ₧8 {πRobert RothenburgππHere's some routines I wrote while playing around with some compressionπalgorithms. Since they're written in Pascal, they're probably not tooπfast but they work.πππOf course they're need some tweaking.π}π(* NoFrills Bit-Input/Output Routines *)π(* Insert "n" bits of data into a Buffer or Pull "n" bits of *)π(* data from a buffer. Useful for Compression routines *)πππunit BitIO;ππinterfaceππconstπ BufferSize = 32767; (* Adjust as appropriate *)ππtypeπ Buffer = array [0..BufferSize] of byte;π BufPtr = ^Buffer;π BuffRec = record (* This was used for I/O by some *)π Block : BufPtr; (* other units involved with the *)π Size, (* compression stuff. Not so *)π Ptr : word; (* Important? *)π Loc : byteπ end;ππvarπ InBuffer,π OutBuffer : BuffRec;π InFile,π OutFile : file;ππprocedure InitBuffer(var x : BuffRec); (* Initialize a buffer *)πprocedure GetBits(var b : word; num : byte); (* Get num bits from *)π (* InBuffer *)πprocedure PutBits(b : word; num : byte); (* Put num bits into *)π (* OutBuffer *)πfunction Log2(x : word) : byte; (* Self-explanatory... *)ππimplementationππconstπ Power : array [1..17] of longint =π (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536);ππprocedure InitBuffer(var x : BuffRec);πbeginπ with x doπ beginπ Loc := 8;π Ptr := 0;π Size := 0;π New(Block);π FillChar(Block^, BufferSize, #0);π end;πend;ππprocedure GetBits(var b : word; num : byte);πvarπ Size : word;πbeginπ with InBuffer doπ beginπ b := 0;π repeatπ b := (b SHL 1);π if (Block^[Ptr] AND Power[Loc]) <> 0 thenπ b := b OR 1;π dec(Loc);π if Loc = 0 thenπ beginπ Loc := 8;π inc(Ptr);π end;π dec(num);π until (num = 0);π end;πend;ππprocedure PutBits(b : word; num : byte);πvarπ i : byte;πbeginπ with OutBuffer doπ repeatπ if Loc = 0 thenπ beginπ inc(Ptr);π Loc := 8;π end;π if (b AND Power[num]) <> 0 thenπ beginπ Block^[Ptr] := Block^[Ptr] OR Power[Loc];π dec(Loc);π endπ elseπ dec(Loc);π dec(num)π until num = 0;π OutBuffer.Size := succ(OutBuffer.Ptr);πend;ππfunction Log2(x : word) : byte;πvarπ i : byte;πbeginπ i := 17;π while x<Power[i] doπ dec(i);π Log2 := i;πend;ππend.π 37 11-21-9309:25ALL SWAG SUPPORT TEAM Bit Handler SWAG9311 44 ₧8 UNIT Bits;π(**) INTERFACE (**)πTYPEπ bbit = 0..7;π wbit = 0..15;π lbit = 0..31;ππ PROCEDURE SetBitB(VAR B : Byte; bit : bbit);π PROCEDURE ClearBitB(VAR B : Byte; bit : bbit);π PROCEDURE ToggleBitB(VAR B : Byte; bit : bbit);π FUNCTION BitSetB(B : Byte; bit : bbit) : Boolean;π FUNCTION BitClearB(B : Byte; bit : bbit) : Boolean;ππ PROCEDURE SetBitW(VAR W : Word; bit : wbit);π PROCEDURE ClearBitW(VAR W : Word; bit : wbit);π PROCEDURE ToggleBitW(VAR W : Word; bit : wbit);π FUNCTION BitSetW(W : Word; bit : wbit) : Boolean;π FUNCTION BitClearW(W : Word; bit : wbit) : Boolean;ππ PROCEDURE SetBitL(VAR L : LongInt; bit : lbit);π PROCEDURE ClearBitL(VAR L : LongInt; bit : lbit);π PROCEDURE ToggleBitL(VAR L : LongInt; bit : lbit);π FUNCTION BitSetL(L : LongInt; bit : lbit) : Boolean;π FUNCTION BitClearL(L : LongInt; bit : lbit) : Boolean;ππ(**) IMPLEMENTATION (**)π PROCEDURE SetBitB(VAR B : Byte; bit : bbit);π Assembler;π ASMπ MOV CL, bitπ MOV BL, 1π SHL BL, CL {BL contains 2-to-the-bit}π LES DI, Bπ OR ES:[DI], BL {OR turns on bit}π END;ππ PROCEDURE ClearBitB(VAR B : Byte; bit : bbit);π Assembler;π ASMπ MOV CL, bitπ MOV BL, 1π SHL BL, CL {BL contains 2-to-the-bit}π NOT BLπ LES DI, Bπ AND ES:[DI], BL {AND of NOT BL turns off bit}π END;ππ PROCEDURE ToggleBitB(VAR B : Byte; bit : bbit);π Assembler;π ASMπ MOV CL, bitπ MOV BL, 1π SHL BL, CL {BL contains 2-to-the-bit}π LES DI, Bπ XOR ES:[DI], BL {XOR toggles bit}π END;ππ FUNCTION BitSetB(B : Byte; bit : bbit) : Boolean;π Assembler;π ASMπ MOV CL, bitπ MOV BL, 1π SHL BL, CL {BL contains 2-to-the-bit}π MOV AL, 0 {set result to FALSE}π TEST B, BLπ JZ @Noπ INC AL {set result to TRUE}π @No:π END;ππ FUNCTION BitClearB(B : Byte; bit : bbit) : Boolean;π Assembler;π ASMπ MOV CL, bitπ MOV BL, 1π SHL BL, CL {BL contains 2-to-the-bit}π MOV AL, 0 {set result to FALSE}π TEST B, BLπ JNZ @Noπ INC AL {set result to TRUE}π @No:π END;ππ PROCEDURE SetBitW(VAR W : Word; bit : wbit);π Assembler;π ASMπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π LES DI, Wπ OR ES:[DI], BX {OR turns on bit}π END;ππ PROCEDURE ClearBitW(VAR W : Word; bit : wbit);π Assembler;π ASMπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π NOT BXπ LES DI, Wπ AND ES:[DI], BX {AND of NOT BX turns off bit}π END;ππ PROCEDURE ToggleBitW(VAR W : Word; bit : wbit);π Assembler;π ASMπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π LES DI, Wπ XOR ES:[DI], BX {XOR toggles bit}π END;ππ FUNCTION BitSetW(W : Word; bit : wbit) : Boolean;π Assembler;π ASMπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π MOV AL, 0 {set result to FALSE}π TEST W, BXπ JZ @Noπ INC AL {set result to TRUE}π @No:π END;ππ FUNCTION BitClearW(W : Word; bit : wbit) : Boolean;π Assembler;π ASMπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π MOV AL, 0 {set result to FALSE}π TEST W, BXπ JNZ @Noπ INC AL {set result to TRUE}π @No:π END;ππ PROCEDURE SetBitL(VAR L : LongInt; bit : lbit);π Assembler;π ASMπ LES DI, Lπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π JZ @TopWord {if zero, use high word}π OR ES:[DI], BX {OR turns on bit}π JMP @Finishπ @TopWord:π SUB CL, 16π MOV BX, 1π SHL BX, CLπ OR ES:[DI+2], BXπ @Finish:π END;ππ PROCEDURE ClearBitL(VAR L : LongInt; bit : lbit);π Assembler;π ASMπ LES DI, Lπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π JZ @TopWord {if zero, use high word}π NOT BXπ AND ES:[DI], BX {AND of NOT BX turns off bit}π JMP @Finishπ @TopWord:π SUB CL, 16π MOV BX, 1π SHL BX, CLπ NOT BXπ AND ES:[DI+2], BXπ @Finish:π END;ππ PROCEDURE ToggleBitL(VAR L : LongInt; bit : lbit);π Assembler;π ASMπ LES DI, Lπ MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π JZ @TopWord {if zero, use high word}π XOR ES:[DI], BX {XOR toggles bit}π JMP @Finishπ @TopWord:π SUB CL, 16π MOV BX, 1π SHL BX, CLπ XOR ES:[DI+2], BXπ @Finish:π END;ππ FUNCTION BitSetL(L : LongInt; bit : lbit) : Boolean;π Assembler;π ASMπ MOV AL, 0 {set result to FALSE}π MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π JZ @TopWord {if zero, use high word}π TEST Word(L), BXπ JMP @Finishπ @TopWord:π SUB CL, 16π MOV BX, 1π SHL BX, CLπ TEST Word(L+2), BXπ @Finish:π JZ @Noπ INC AL {set result to TRUE}π @No:π END;ππ FUNCTION BitClearL(L : LongInt; bit : lbit) : Boolean;π Assembler;π ASMπ MOV AL, 0 {set result to FALSE}π MOV CL, bitπ MOV BX, 1π SHL BX, CL {BX contains 2-to-the-bit}π JZ @TopWord {if zero, use high word}π TEST Word(L), BXπ JMP @Finishπ @TopWord:π SUB CL, 16π MOV BX, 1π SHL BX, CLπ TEST Word(L+2), BXπ @Finish:π JNZ @Noπ INC AL {set result to TRUE}π @No:π END;πEND.π 38 11-21-9309:36ALL SWAG SUPPORT TEAM HILO Bit Operators SWAG9311 12 ₧8 UNIT HiLo;π(**) INTERFACE (**)π FUNCTION SwapN(B : Byte) : Byte;π FUNCTION HiN(B : Byte) : Byte;π FUNCTION LoN(B : Byte) : Byte;ππ FUNCTION SwapW(L : LongInt) : LongInt;π FUNCTION HiW(L : LongInt) : Word;π FUNCTION LoW(L : LongInt) : Word;ππ FUNCTION WordFromB(H, L : Byte) : Word;π FUNCTION LongFromW(H, L : Word) : LongInt;ππ(**) IMPLEMENTATION (**)π FUNCTION SwapN(B : Byte) : Byte; Assembler;π ASMπ MOV AL, B {byte in AL}π MOV AH, AL {now in AH too}π MOV CL, 4 {set up to shift by 4}π SHL AL, CL {AL has low nibble -> high}π SHR AH, CL {AH has high nibble -> low}π ADD AL, AH {combine them}π END;ππ FUNCTION HiN(B : Byte) : Byte; Assembler;π ASMπ MOV AL, Bπ MOV CL, 4π SHR AL, CLπ END;ππ FUNCTION LoN(B : Byte) : Byte; Assembler;π ASMπ MOV AL, Bπ AND AL, 0Fhπ END;ππ FUNCTION SwapW(L : LongInt) : LongInt; Assembler;π ASMπ MOV AX, Word(L+2)π MOV DX, Word(L)π END;ππ FUNCTION HiW(L : LongInt) : Word; Assembler;π ASMπ MOV AX, Word(L+2)π END;ππ FUNCTION LoW(L : LongInt) : Word; Assembler;π ASMπ MOV AX, Word(L);π END;ππ FUNCTION WordFromB(H, L : Byte) : Word; Assembler;π ASMπ MOV AH, Hπ MOV AL, Lπ END;ππ FUNCTION LongFromW(H, L : Word) : LongInt; Assembler;π ASMπ MOV DX, Hπ MOV AX, Lπ END;πEND.
